(* ===================================================== *)
(** Debut d'un travail sur des outils de pretty printing *)
(* ===================================================== *)

open Bplib
open Inputtools
open Circuit

module ToString =
struct

  let rec expr = function
    | VAR s -> s
    | CST c -> string_of_int c
    | ADD (a, b) -> "("^(expr a)^" + "^(expr b)^")"
    | SUB (a, b) -> "("^(expr a)^" - "^(expr b)^")"
    | DIV (a, b) -> "("^(expr a)^" / "^(expr b)^")"
    | MULT (a, b) -> "("^(expr a)^" * "^(expr b)^")"
    | MOD (a, b) ->  "("^(expr a)^" mod "^(expr b)^")"
    | EXP (a, b) ->  "("^(expr a)^" ^ "^(expr b)^")"
    | MIN (a, b) -> "min("^(expr a)^", "^(expr b)^")" 
    | MAX (a, b) -> "max("^(expr a)^", "^(expr b)^")" 
    | LOG e -> "log("^(expr e)^")" 

  let rec cond = function 
    | CONST e1 -> expr e1 
    | COND_EQ (e1, e2) -> "("^(expr e1)^" = "^(expr e2)^")"
    | COND_NEQ (e1, e2) -> "("^(expr e1)^" <> "^(expr e2)^")"
    | COND_PP (e1, e2) ->  "("^(expr e1)^" <= "^(expr e2)^")"
    | COND_PG (e1, e2) ->  "("^(expr e1)^" >= "^(expr e2)^")"
    | COND_SPP (e1, e2) -> "("^(expr e1)^" < "^(expr e2)^")"
    | COND_SPG (e1, e2) -> "("^(expr e1)^" > "^(expr e2)^")"
    | COND_NEG c1 -> "!("^(cond c1)^")"
    | COND_OR (c1, c2) ->  "("^(cond c1)^" || "^(cond c2)^")"
    | COND_AND (c1, c2) ->  "("^(cond c1)^" && "^(cond c2)^")" 

  let expr_param_indexation = function
    | SegmentInit e -> ":["^(expr e)^"]"
    | Intervalle (a, b) -> Printf.sprintf "[%s..%s]" (expr a) (expr b)
    | Index i -> "["^(expr i)^"]"

  let net_variable = function 
    | Vecteur (line, name, param_list) -> Printf.sprintf "%s%s" name (string_of_list expr_param_indexation "" "" "" param_list)
    | Simple s -> s
    | Fresh f -> Printf.sprintf "__fresh_%d" f

  let arite_pipe = function
    | Infere -> ""
    | Calcul e -> Printf.sprintf "[%s]" (expr e)
    | Resultat i -> Printf.sprintf "[%d]" i

  let argt_fct = function 
    | PASSING_STYLE s -> s
    | CONSTRUCTION s -> Printf.sprintf "\"%s\"" s

  let portee_noeud vide = function 
    | BEBOP (name, expr_list, argfct_list) -> 
	Printf.sprintf "%s%s%s(" name (string_of_list expr "][" "[" "]" expr_list) (string_of_list argt_fct ", " "<" ">" argfct_list)
    | EXTERNAL_BLOC (name, methode, args, aritep) ->
	begin
	  match methode with
	  | Some m -> Printf.sprintf "$%s.%s%s(%s" name (!m) (arite_pipe aritep) (string_of_list (Printf.sprintf "\"%s\"") ", " "" ", " args)
	  | None ->  Printf.sprintf "$%s%s(%s" name (arite_pipe aritep) (string_of_list (Printf.sprintf "\"%s\"") ", " "" ", " args)
	end
    | PIPE (com, aritep) -> (Printf.sprintf "pipe%s(\"%s\"" (arite_pipe aritep) com)^(if vide then "" else ", ")

  let net_imbrication =
    let rec aux = function (* avec ident en plus fixme *)
      | NET_VARS nets -> string_of_list net_variable ", " "" "" nets
      | IMB (line, portee, imblist) ->  
	  Printf.sprintf "%s%s)" (portee_noeud (imblist = []) portee) (string_of_list aux ", " "" "" imblist)
    in aux
      
  (* C'est la la seule difficulte, comme on laisse la possibilite de masquage de variable dans les boucles, 
     il ne faut pas oublier d'enlever ces variables avant les appels recursifs *)
  let rec net_noeud = 
    let rec aux ident = function
      | NOEUD (line, portee, imblist, netvars) ->
	  Printf.sprintf "%s%s = %s%s);" (String.make ident ' ') (string_of_list net_variable ", " "" "" netvars) (portee_noeud (netvars = []) portee) 
	    (string_of_list net_imbrication ", " "" "" imblist) 

      | BOUCLE_FOR (line, var, a, b, nodelist) ->
	  (Printf.sprintf "%sfor %s = %s to %s\n" (String.make ident ' ') var (expr a) (expr b))
	  ^(string_of_list (aux (ident + 2)) "\n" "" "" nodelist)
	  ^(Printf.sprintf "%send for;" (String.make ident ' '))

      | NOEUD_COND (line, condt, nodethenlist, nodeelselist) ->
	  (Printf.sprintf "%sif %s\n" (String.make ident ' ') (cond condt))
	  ^(Printf.sprintf "%sthen\n" (String.make ident ' '))
	  ^(string_of_list (aux (ident + 2)) "\n" "" "\n" nodethenlist)
	  ^(string_of_list (aux (ident + 2)) "\n" (Printf.sprintf "%selse\n" (String.make ident ' ')) "\n" nodeelselist)
	  ^(Printf.sprintf "%send if;" (String.make ident ' '))
    in aux 2    

  let declaration_fonction f =
    let fct =
      (
	Printf.sprintf "%s (%s) = (%s)\nwhere\n%s\nend where;"
	  f.nom_dcl_f
	  (string_of_list net_variable ", " "" "" f.entrees_dcl_f)
	  (string_of_list net_variable ", " "" "" f.sorties_dcl_f)
	  (string_of_list net_noeud "\n" "" "" f.corps_dcl_f)
      )
    and att = string_of_list (fun s -> s)  ", " "[" "]\n" f.attribut_dcl_f in
    att^fct

end;;
  

let print_declaration_fonction fct a = fct (ToString.declaration_fonction a)
